COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	IFCR ¬DECLARATION(EXTENDED_COMPILATION) THENC
C00004 00003	! ALPRIN
C00017 00004	! pvdo & pvldo
C00021 ENDMK
C⊗;
IFCR ¬DECLARATION(EXTENDED_COMPILATION) THENC

	ENTRY;

BEGIN  "ALPRIN"

    IFCR ¬DECLARATION(CREFFING) THENC DEFINE CREFFING="FALSE"; ENDC
    IFCR ¬ CREFFING THENC
	REQUIRE "ALREQ.HDR[AL,HE]" SOURCE_FILE;
    ENDC
    REDEFINE $$PRGID "[]" = ["ALPRIN"];
    IFCR CREFFING THENC REQUIRE $$PRGID MESSAGE; ENDC
ENDC


INTERNAL INTEGER PSPCIX;INITIALIZE(PSPCIX←0);

INTERNAL SIMPLE PROCEDURE PRCRLF;
	PRINT(CRLF,("                      "
		   &"                      ")[1 FOR PSPCIX]);


INTERNAL SIMPLE STRING PROCEDURE CVRAD(REAL W);
	RETURN(CVF(W/180)&"*π");

INTERNAL SIMPLE STRING PROCEDURE CVDEG(REAL W);
	RETURN(CVF(W)&"*DEG");

INTERNAL SIMPLE STRING PROCEDURE CVGX(REAL R);
	RETURN(TBLKSUPPRESS(CVG(R)));

STRING PROCEDURE LBLID(RPTR(LBLVAR) LBL);
	RETURN(IF LBL=NULL_RECORD THEN "<nameless>" ELSE
		ITMNAM(LBLVAR:NAME[LBL]));
! ALPRIN;

INTERNAL RECURSIVE PROCEDURE ALPRIN(RANY S);
	BEGIN "ALPRIN"
	LABEL REPRINT,XIT,HALPR2,HALPR3;
	INTEGER ST;
	RCELL C;

	RECURSIVE PROCEDURE HPFIN(RCELL C);
		BEGIN
		PSPCIX←PSPCIX+1;
		WHILE C≠NULL_RECORD DO ALPRIN(LLOP(C));
		PRCRLF;
		PSPCIX←PSPCIX-1;
		END;

REPRINT:
	ST←RECTYPE(S);
	
	IF ST=LOC(SVAL) THEN
		PRINT(SVAL:VAL[S])
	ELSE IF ST=LOC(V3ECT) THEN
		BEGIN
		BOOLEAN PROCEDURE VPRINT(RPTR(V3ECT) V,NV;STRING ID);
			BEGIN
			RANY SS; ! because of SAIL dryrot;
			SS←S;
			IF V3DIST(SS,V)=0 THEN PRINT(" "&ID)
			ELSE IF V3DIST(SS,NV)=0 THEN PRINT("-"&ID)
			ELSE RETURN(FALSE);
			RETURN(TRUE);
			END;
		IF ¬VPRINT(NILVECT,NILVECT,"NILVECT") ∧
		   ¬VPRINT(XHAT,NEGXHAT,"XHAT") ∧
		   ¬VPRINT(YHAT,NEGYHAT,"YHAT") ∧
		   ¬VPRINT(ZHAT,NEGZHAT,"ZHAT") THEN
			    PRINT(" VECTOR(", CVGX(V3ECT:X[S]),",",
				 CVGX(V3ECT:Y[S]),",",CVGX(V3ECT:Z[S]),")" );
		END
	ELSE IF ST=LOC(ROTN) THEN
		BEGIN
		IF S=NILROTN THEN
			PRINT(" NILROTN")
		ELSE
			BEGIN
			PRINT(" ROTN( ");
			ALPRIN(ROTN:AXIS[S]);
			PRINT(",",CVDEG(ROTN:MAGN[S]),")");
			END;
		END
	ELSE IF ST=LOC(TRANS) THEN
		BEGIN  !  Modified by RF;
		IF S=NILTRANS THEN
			PRINT(" NILTRANS")
		ELSE
			BEGIN
			PRINT(" TRANS(");
			ALPRIN(TRANS:R[S]);
			PRINT(",");
			ALPRIN(TRANS:P[S]);
			PRINT(")");
			END;
		END
	ELSE IF ST=LOC(FRAME) THEN
		BEGIN  !  Modified by RF;
		IF S=STATION THEN
			PRINT(" STATION")
		ELSE BEGIN
			PRINT(" FRAME(");
			ALPRIN(TRANS:R[FRAME:VAL[S]]);
			PRINT(",");
			ALPRIN(TRANS:P[FRAME:VAL[S]]);
			PRINT(")");
			END;
		END
	ELSE IF ST=LOC(VARIABLE) THEN 
		BEGIN
		PRINT(" ",VARIABLE:NAME[S]);
		END
	ELSE IF ST=LOC(STCONST) THEN 
		BEGIN
		PRINT(" ",DATUM(STCONST:VAL[S]));
		END
	ELSE IF ST=LOC(EXPRN) THEN
		BEGIN
		PRINT("(",OP_MNE[EXPRN:OP[S]]);
		C←EXPRN:ARGS[S];
		WHILE C≠NULL_RECORD DO ALPRIN(LLOP(C));
		PRINT(")");
		END
	ELSE IF ST=LOC(VNODE) THEN
		BEGIN
		PRINT("[INV=",VNODE:INVMARK[S],",VAL=");
		ALPRIN(VNODE:NOMVAL[S]);
		PRINT("]");
		END
	ELSE IF ST=LOC(CALCULATOR) THEN
		BEGIN
		PRINT("( calc ",LBLID(CALCULATOR:LBL[S]),": ");
		ALPRIN(CALCULATOR:FORM[S]);
		PRINT(")");
		END
	ELSE IF ST=LOC(CHANGER) THEN
		BEGIN
		PRINT("(changer ",LBLID(CHANGER:LBL[S]),": ");
		ALPRIN(CHANGER:CODE[S]);
		PRINT(")");
		END
	ELSE IF ST=LOC(STMNT) THEN
		BEGIN
		ALPRIN(STMNT:SEMANTICS[S]);
		PRINT(" [IW=",STMNT:IW[S],",OW=",STMNT:OW[S],"]");
		END
	ELSE IF ST=LOC(AFACT) THEN
		BEGIN
		PRINT("(");
		ALPRIN(AFACT:LEFT[S]);
		PRINT(" ","<≤=≥>"[AFACT:RELN[S]+3 FOR 1]);
		ALPRIN(AFACT:RIGHT[S]);
		PRINT(")");
		END
	ELSE IF ST=LOC(SFACT) THEN
		BEGIN
		PRINT(" FACT ");
		S←SFACT:PATT[S];
		GO TO REPRINT;
		END
	ELSE IF ST=LOC(CELL) THEN
		BEGIN
		PRINT("(");
		WHILE S≠NULL_RECORD DO
			BEGIN
			ALPRIN(CELL:CAR[S]);
			S←CELL:CDR[S];
			END;
		PRINT(" )");
		END
	ELSE IF ST=0 THEN
		PRINT(" NULL_RECORD ")
	ELSE IF ST=LOC(CMON) THEN
		BEGIN
		!  Recoded by RF;
		IF CMON:FLAGS[S] THEN PRINT(" (ON ") ELSE PRINT(" (DEFER ON ");
		ALPRIN(CMON:CONDITION[S]);
		PRINT(" DO ");
		ALPRIN(CMON:CONCLUSION[S]);
		PRINT(" )");
		END
	ELSE IF ST = LOC(EVDO) THEN
		BEGIN  ! Added by RF;
		PRCRLF;
		IF EVDO:OP[S] = 0
		THEN PRINT("(SIGNAL ")
		ELSE PRINT("(WAIT ");
		ALPRIN(EVDO:VAR[S]);
		PRINT(")");
		END
	ELSE
		BEGIN
		GO TO HALPR2;
		! this admittedly ugly goto statement is here
		  because otherwise you have to use a bigger 
		  parse stack in compiling this program, which
		  is a real pain. ;
		END;
	GO TO XIT; ! see the remark immediately above;
	HALPR2: IF ST = LOC(CMABLE) THEN
		BEGIN  ! Added by ARG;
		PRCRLF;
		IF CMABLE:FLAG[S] THEN PRINT("(ENABLE ") ELSE PRINT("(DISABLE ");
		IF RECTYPE(CMABLE:WHAT[S]) = LOC(LBLVAR) THEN 
			PRINT(LBLVAR:NAME[CMABLE:WHAT[S]]);
		PRINT(")");
		END
	ELSE	BEGIN
		PRCRLF;
		PRINT("(",CVRTS(ST));
		IF ST=LOC(BLOCK)∨ST=LOC(COBLOCK) THEN
			BEGIN
			IF ST=LOC(BLOCK)
			    THEN BEGIN  ! Modified by RF;
			    C ← BLOCK:VARS[S];
			    HPFIN(C);
			    C ← BLOCK:CODE[S];
			    END
			ELSE IF ST=LOC(COBLOCK) THEN
				C←COBLOCK:CODE[S];
			HPFIN(C);
			END
		ELSE IF ST=LOC(PROG) THEN
			BEGIN
			ALPRIN(PROG:CODE[S]);
			END
		ELSE IF ST=LOC(ASSIGNMENT) THEN
			BEGIN
			ALPRIN(ASSIGNMENT:VAR[S]);
			PRINT(" ");
			ALPRIN(ASSIGNMENT:VAL[S]);
			END
		ELSE IF ST=LOC(GASSIGN) THEN
			BEGIN
			ALPRIN(GASSIGN:VAR[S]);
			PRINT("=≠<"[GASSIGN:OP[S] FOR 1]);
			ALPRIN(GASSIGN:CLC[S]);
			END
		ELSE IF ST=LOC(ASSERT)∨ST=LOC(DENY) THEN
			BEGIN
			ALPRIN(ASSERT:FACT[S]);
			PRINT(" IN ",ASSERT:WLD[S]);
			END
		ELSE IF ST=LOC(MOVE$) THEN
			BEGIN
			ALPRIN(MOVE$:WHAT[S]);
			PRINT(" TO ");
			ALPRIN(MOVE$:DEST[S]);
			IF MOVE$:CLAUSES[S]≠NULL_RECORD THEN
				BEGIN
				PSPCIX←PSPCIX+1;
				HPFIN(MOVE$:CLAUSES[S]);
				PSPCIX←PSPCIX-1;
				END;
			END
		ELSE IF ST=LOC(CENTER) THEN
			BEGIN
			ALPRIN(CENTER:CF[S]);
			IF CENTER:CLAUSES[S]≠NULL_RECORD THEN
				BEGIN
				PSPCIX←PSPCIX+1;
				HPFIN(CENTER:CLAUSES[S]);
				PSPCIX←PSPCIX-1;
				END;
			END
		ELSE IF ST=LOC(PVL) THEN
			ALPRIN(PVL:VL[S])
		ELSE IF ST=LOC(IFF) THEN
			BEGIN
			ALPRIN(IFF:COND[S]);
			PSPCIX←PSPCIX+1;
			ALPRIN(IFF:THN[S]);
			ALPRIN(IFF:ELS[S]);
			PRCRLF;
			PSPCIX←PSPCIX-1;
			END
		ELSE IF ST = LOC(WHIL) THEN
			BEGIN
			ALPRIN(WHIL:COND[S]);
			PSPCIX←PSPCIX+1;
			PRCRLF;
			ALPRIN(WHIL:BODY[S]);
			PSPCIX←PSPCIX-1;
			END
		ELSE IF ST = LOC(VIA) THEN
			BEGIN "via"
			ALPRIN(VIA:PLACE[S]);
			IF VIA:VELOC[S] ≠ RNULL THEN ALPRIN(VIA:VELOC[S]);
			IF VIA:TIME[S] ≠ RNULL THEN ALPRIN(VIA:TIME[S]);
			IF VIA:CODE[S] ≠ RNULL THEN ALPRIN(VIA:CODE[S]);
			END "via"
		ELSE IF ST = LOC(DURATION) THEN
			BEGIN "duration"
			PRINT(CASE DURATION:TIME_RELN[S] OF
			    (" ? "," > "," < "," = "));
			ALPRIN(DURATION:TIME[S]);
			END "duration"
		ELSE IF ST = LOC(VELOCITY) THEN
			ALPRIN(VELOCITY:VELOC[S])
		ELSE GOTO HALPR3;
		PRINT(")");
		GOTO XIT;
	HALPR3: IF ST = LOC(OPENING) THEN
			ALPRIN(OPENING:VAL[S])
		ELSE IF ST = LOC(ARRIVAL) THEN
			ALPRIN(ARRIVAL:THRU[S])
		ELSE IF ST = LOC(DEPARTURE) THEN
			ALPRIN(DEPARTURE:THRU[S])
		ELSE IF ST = LOC(FORCE) THEN
			BEGIN
			PRINT(IF FORCE:REL[S] = SIGLT THEN " < " ELSE " ≥ ");
			ALPRIN(FORCE:VAL[S]);
			PRINT(IF FORCE:TYPE[S] THEN " ALONG " ELSE " ABOUT ");
			ALPRIN(FORCE:DIRECT[S]);
			IF FORCE:F_F[S] ≠ RNULL THEN
			    BEGIN
			    PRINT( " OF ");
			    ALPRIN(F_FRAME:FRAME[FORCE:F_F[S]]);
			    PRINT( " IN ");
			    PRINT(IF F_FRAME:C_SYS[FORCE:F_F[S]]=FHAND THEN " HAND"
				ELSE " TABLE ");
			    END;
			END
		ELSE IF ST = LOC(F_FRAME) THEN
			BEGIN
			ALPRIN(F_FRAME:FRAME[S]);
			PRINT(IF F_FRAME:C_SYS[S] = FTABLE THEN " TABLE " 
			    ELSE " HAND ");
			END
		ELSE IF ST = LOC(WOBBLE) THEN
			ALPRIN(WOBBLE:VAL[S])
		ELSE IF ST = LOC(S_FAC) THEN
			ALPRIN(S_FAC:VAL[S])
		ELSE IF ST = LOC(ABORT) THEN
			ALPRIN(ABORT:VAL[S])
		ELSE IF ST = LOC(STOP) THEN
			ALPRIN(STOP:CF[S])
		ELSE IF ST = LOC(PAUSE) THEN
			ALPRIN(PAUSE:VAL[S])
		ELSE IF ST = LOC(PRNT) THEN
			ALPRIN(PRNT:VAL[S])
		ELSE IF ST = LOC(NOTE) THEN
			ALPRIN(NOTE:HESAYS[S])
		ELSE IF ST = LOC(NOTE1) THEN
			ALPRIN(NOTE1:HESAYS[S])
		ELSE IF ST = LOC(NOTE2) THEN
			ALPRIN(NOTE2:HESAYS[S])
		ELSE
			BEGIN
			RECPRN(S);
			END;
		PRINT(")");
		END;
XIT:	RETURN
	END "ALPRIN";

PROCEDURE INIPFS;
	BEGIN
	INTEGER HPL;
	HPL←LOC(ALPRIN);
	SETRPM(LOC(FRAME),HPL);
	SETRPM(LOC(TRANS),HPL);
	SETRPM(LOC(ROTN),HPL);
	SETRPM(LOC(STMNT),HPL);
	SETRPM(LOC(BLOCK),HPL);
	SETRPM(LOC(VARIABLE),HPL);
	SETRPM(LOC(CHANGER),HPL);
	SETRPM(LOC(CALCULATOR),HPL);
	SETRPM(LOC(EXPRN),HPL);
	END;

REQUIRE INIPFS INITIALIZATION;
! pvdo & pvldo;

PROCEDURE ATLPRT(ITEMVAR W;STRING ATTID;RPTR(SET_FLUENT) ATTFL);
        BEGIN
        INTEGER FLG;
        RANY VV;
	PRCRLF;
        PRINT(TAB&'0,ATTID,"=");
        PSPCIX←PSPCIX+10;
        FLG←0;
        ∀ | SATISFY_SET_FLUENT(W,ATTFL,VV) DO
                BEGIN
		IF FLG THEN
	                PRCRLF;
                ALPRIN(VV);
                FLG←1;
                END;
        IF ¬FLG THEN PRINT(" <NONE> ");
        PSPCIX←PSPCIX-10;
        END;

INTERNAL PROCEDURE PCDO(RPTR(CALCULATOR) V;ITEMVAR WLD);
	BEGIN

	! prints out a "pretty" version of the graph node
	for calculator V in world WLD.;

	RPTR(VNODE) GN;
	GN←GETFREC(CALCULATOR:PLNVAL[V],WLD);
	PRCRLF;
	PRINT("IN WORLD ",WLD,", CALCULATOR ",LBLID(CALCULATOR:LBL[V]),
			" HAS GRAPH PROPERTIES:");
	PSPCIX←PSPCIX+10;
	PRCRLF;
	PRINT("VALUE NODE =");
	ALPRIN(GN);
	PSPCIX←PSPCIX-10;
	PRCRLF;
	ATLPRT(WLD,"DEPS",CALCULATOR:DEPS[V]);
	PRCRLF;
	END;

INTERNAL PROCEDURE PVDO(RPTR(VARIABLE) V;ITEMVAR WLD);
	BEGIN

	! prints out a "pretty" version of the graph node
	for variable VAR in world WLD.;

	RPTR(VNODE) GN;
	RPTR(CALCULATOR) C;
	BOOLEAN FLG;

	GN←GETFREC(VARIABLE:PLNVAL[V],WLD);
	PRCRLF;
	PRINT("IN WORLD ",ITMNAM(WLD),", ",VARIABLE:NAME[V],
		" HAS GRAPH PROPERTIES:");
	PSPCIX←PSPCIX+10;
	PRCRLF;
	PRINT("VALUE NODE =");
	ALPRIN(GN);
	PSPCIX←PSPCIX-10;
	ATLPRT(WLD,"DEPS",VARIABLE:DEPS[V]);
	ATLPRT(WLD,"CALCS",VARIABLE:CALCS[V]);
	ATLPRT(WLD,"CHANGERS",VARIABLE:CHANGERS[V]);
	PRCRLF;
	PSPCIX←PSPCIX+10;
	∀ | SATISFY_SET_FLUENT(WLD,VARIABLE:CALCS[V],C) DO
		BEGIN
		PCDO(C,WLD);
		FLG←TRUE;
		END;
	PSPCIX←PSPCIX-10;
	PRCRLF;
	END;

INTERNAL PROCEDURE PVLDO(RCELL C;ITEMVAR WLD);
	BEGIN
	WHILE C≠NULL_RECORD DO 
		BEGIN
		PVDO(CHKREC(CELL:CAR[C],LOC(VARIABLE)),WLD);
		C←CELL:CDR[C];
		END;
	END;

END $$PRGID;